School gardens in urban Hanoi
We model a decision impact pathway is for school gardens as a general intervention for sustainable children’s food environments in urban Hanoi, Vietnam (Whitney et al. 2024).
Conceptual model of school gardens as an intervention. Should urban Hanoi school boards invest time and money in creating school gardens? Should they invest in formal STEM education as part of these gardens?
Urban Hanoi school garden
Simulation of the school garden intervention options:
# Source our model
source("Garden_Model.R")
# Ensure consistent results with the random number generator
# not for each 'run' of the MC simulation but for
# consistency each time we run the entire simulation
set.seed(42)
garden_simulation_results <- mcSimulation(
estimate = estimate_read_csv("data/inputs_school_garden.csv"),
model_function = school_garden_function,
numberOfModelRuns = 1e4, #run 10,000 times
functionSyntax = "plainNames"
)The Net Present Value (i.e. current value of the future benefits) of the garden decision options over 5 years of the intervention. For public and private schools the STEM costs are considered to be in the same garden space but with the additional costs and benefits of a full STEM education program. All options are compared to the same years of using the land for something that is not related to the garden, i.e. as a playground or for parking. Here we plot the distribution for the decision and frame the projected NPV.
For public schools:
source("functions/plot_distributions.R")
plot_distributions(mcSimulation_object = garden_simulation_results,
vars = c("NPV_garden_public_school_inclusive",
"NPV_garden_STEM_public_school_inclusive"),
old_names = c("NPV_garden_public_school_inclusive", "NPV_garden_STEM_public_school_inclusive"),
new_names = c("NPV public school passive garden", "NPV public school STEM garden"),
method = 'smooth_simple_overlay',
base_size = 7,
x_axis_name = "Comparative NPV outcomes")
For private schools:
source("functions/plot_distributions.R")
plot_distributions(mcSimulation_object = garden_simulation_results,
vars = c("NPV_garden_inclusive","NPV_garden_STEM_inclusive"),
old_names = c("NPV_garden_inclusive","NPV_garden_STEM_inclusive"),
new_names = c("NPV private school passive garden","NPV private school STEM garden"),
method = 'smooth_simple_overlay',
base_size = 7,
x_axis_name = "Comparative NPV outcomes")
The same results again but this time as boxplots:
source("functions/plot_distributions.R")
plot_distributions(mcSimulation_object = garden_simulation_results,
vars = c("NPV_garden_inclusive","NPV_garden_STEM_inclusive", "NPV_garden_public_school_inclusive", "NPV_garden_STEM_public_school_inclusive"),
old_names = c("NPV_garden_inclusive","NPV_garden_STEM_inclusive", "NPV_garden_public_school_inclusive", "NPV_garden_STEM_public_school_inclusive"),
new_names = c("NPV private school passive garden","NPV private school STEM garden", "NPV public school passive garden", "NPV public school STEM garden"),
method = "boxplot",
base_size = 11,
x_axis_name = "Comparative NPV outcomes (million VND)")
ggsave("figures/Fig_5_Boxplots.png", width = 15, height = 8, units = "cm")As boxplots and distributions for public schools:
source("functions/plot_distributions.R")
plot_distributions(mcSimulation_object = garden_simulation_results,
vars = c("NPV_garden_public_school_inclusive", "NPV_garden_STEM_public_school_inclusive"),
old_names = c("NPV_garden_public_school_inclusive", "NPV_garden_STEM_public_school_inclusive"),
new_names = c("NPV public school garden", "NPV public school garden with STEM"),
method = "boxplot_density",
base_size = 7,
x_axis_name = "Comparative NPV outcomes")
As boxplots and distributions for private schools:
source("functions/plot_distributions.R")
plot_distributions(mcSimulation_object = garden_simulation_results,
vars = c("NPV_garden_inclusive","NPV_garden_STEM_inclusive"),
old_names = c("NPV_garden_inclusive","NPV_garden_STEM_inclusive"),
new_names = c("NPV private school garden","NPV private school with STEM"),
method = "boxplot_density",
base_size = 7,
x_axis_name = "Comparative NPV outcomes")
Summary of results for the decision
Summary of the NPVs for the passive education garden and STEM options for private schools:
summary(garden_simulation_results$y[1:2]) #"NPV_garden_inclusive" "NPV_garden_STEM_inclusive"## NPV_garden_inclusive NPV_garden_STEM_inclusive
## Min. : -693.6 Min. :-2993.6
## 1st Qu.: 677.1 1st Qu.: 164.0
## Median : 1333.1 Median : 835.1
## Mean : 1605.4 Mean : 1048.1
## 3rd Qu.: 2264.3 3rd Qu.: 1730.0
## Max. :11540.9 Max. :10653.8Summary of the NPVs for the passive education garden and STEM options for public schools:
summary(garden_simulation_results$y[3:4]) #"NPV_garden_public_school_inclusive" "NPV_garden_STEM_public_school_inclusive"## NPV_garden_public_school_inclusive NPV_garden_STEM_public_school_inclusive
## Min. : -693.6 Min. :-2993.6
## 1st Qu.: -218.7 1st Qu.: -268.9
## Median : 510.8 Median : -138.5
## Mean : 884.4 Mean : 401.9
## 3rd Qu.: 1577.3 3rd Qu.: 870.5
## Max. :11540.9 Max. :10653.8Summary of the child health outcomes for private and public schools:
summary(garden_simulation_results$y[10:11]) #"health" "health_STEM" ## health health_STEM
## Min. : 0.0 Min. : 0.0
## 1st Qu.: 293.2 1st Qu.: 272.7
## Median : 697.2 Median : 593.7
## Mean : 762.9 Mean : 605.2
## 3rd Qu.:1116.2 3rd Qu.: 883.1
## Max. :5135.4 Max. :3156.9Summary of the biodiversity outcomes for the passive education garden and STEM options for private and public schools:
summary(garden_simulation_results$y[9]) #"biodiversity"## biodiversity
## Min. : 0.0000
## 1st Qu.: 0.4342
## Median : 3.1548
## Mean : 4.6461
## 3rd Qu.: 7.0055
## Max. :52.7607Summary of costs
Total expected costs for a school garden with and without STEM education:
summary(garden_simulation_results$y[12:13])## total_costs total_costs_STEM
## Min. : 91.09 Min. : 146.0
## 1st Qu.:198.37 1st Qu.: 360.1
## Median :447.99 Median : 869.7
## Mean :395.30 Mean : 939.0
## 3rd Qu.:531.17 3rd Qu.:1276.9
## Max. :937.99 Max. :4837.2First year expected costs for a school garden:
summary(garden_simulation_results$y$Cashflow_garden1)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -347.316 -103.374 -2.415 58.406 162.782 2046.120First year expected costs for a school garden with STEM education:
summary(garden_simulation_results$y$Cashflow_garden_STEM1)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1095.15 -244.78 -136.34 -88.06 30.08 1973.99Cash flows
Cash flow plots of the garden option without formal STEM education. These are the expected returns for public and private schools over the intervention.
# Cashflow of the garden option without formal STEM education
# This will be the cost for public and private schools over the intervention.
source("functions/plot_cashflow.R")
plot_cashflow_garden <- plot_cashflow(mcSimulation_object = garden_simulation_results,
cashflow_var_name = "Cashflow_garden",
facet_labels = "Passive garden") +
theme(legend.position = "none", axis.title.y = element_blank(),
axis.title.x = element_blank(),
axis.text.x = element_blank(),
axis.ticks = element_blank())
# Cashflow of the garden option with formal STEM education
source("functions/plot_cashflow.R")
plot_cashflow_STEM <- plot_cashflow(mcSimulation_object = garden_simulation_results,
cashflow_var_name = "Cashflow_garden_STEM",
facet_labels = "STEM garden")+
labs(y = "Cashflow (million VND)")
# # manually share axis label (not a feature of patchwork)
#
# ylab <- plot_cashflow_garden$labels$y
# plot_cashflow_garden$labels$y <- plot_cashflow_STEM$labels$y <- " "
#
# h_patch <- plot_cashflow_garden / plot_cashflow_STEM
# # Use the tag label as a y-axis label
# wrap_elements(h_patch) +
# labs(tag = "Cashflow") +
# theme(
# plot.tag = element_text(size = rel(1), angle = 90),
# plot.tag.position = "left"
# )
plot_cashflow_garden / plot_cashflow_STEM
ggsave("figures/Fig_6_cashflow.png", width=5, height=5) Projection to Latent Structures (PLS)
We use Projection to Latent Structures (PLS) model to assess the
correlation strength and direction for model variables and outcome
variables. The Partial Least Squares is fitted with the orthogonal
scores algorithm with pls::plsr.
PLS for private schools:
# For passive education garden option
source("functions/pls_model.R")
pls_result <- pls_model(object = garden_simulation_results,
resultName = names(garden_simulation_results$y)[1], # the "NPV_garden_inclusive"
ncomp = 1)
# read in the common input table
input_table <- read.csv("data/inputs_school_garden.csv")
label_private_school <- "Private school"
# source the plot function
source("functions/plot_pls.R")
plot_pls_garden <- plot_pls(plsrResults = pls_result,
input_table = input_table,
threshold = 0.9) +
theme(legend.position = "none", axis.title.x = element_blank(),
axis.text.x = element_blank(),
axis.ticks = element_blank()) + scale_x_continuous(limits = c(0, 7)) + ggtitle(label_private_school) +
annotate(geom="text", x=5, y=1, label="Passive garden")
#For school garden with formal STEM education
pls_result_STEM <- pls_model(object = garden_simulation_results,
resultName = names(garden_simulation_results$y)[2], # the "NPV_garden_STEM"
ncomp = 1)
plot_pls_STEM <- plot_pls(plsrResults = pls_result_STEM,
input_table = input_table,
threshold = 0.9) +
scale_x_continuous(limits = c(0, 7)) +
annotate(geom="text", x=5, y=1, label="STEM garden")
plot_pls_garden / plot_pls_STEM 
Interpretation of PLS results for private schools
Garden options for private schools:
source("functions/pls_posthoc.R")
pls_posthoc(plsrResults = pls_result, threshold = 0.9)## Data: X dimension: 10000 85
## Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
## 1 comps
## X 1.198
## y 81.087
## Data: X dimension: 10000 85
## Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
## 1 comps
## X 1.198
## y 81.087
## Data: X dimension: 10000 85
## Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
## 1 comps
## X 1.198
## y 81.087
## PLS Model Summary:
## Number of Components: 1
## R-squared Value for Y:
## % Variance Explained in X:
## % Variance Explained in Y:
##
## Important Variables (VIP > 0.9):
## Variable
## if_community_likes if_community_likes
## if_garden_yield_enough if_garden_yield_enough
## garden_mental_health_value garden_mental_health_value
## child_garden_health_care_savings child_garden_health_care_savings
## child_garden_school_performance_value child_garden_school_performance_value
## school_event_value school_event_value
## school_event_freq school_event_freq
## VIP Coefficient
## if_community_likes 3.5842837 447.0804
## if_garden_yield_enough 0.9928668 123.8438
## garden_mental_health_value 2.0635014 257.3878
## child_garden_health_care_savings 3.2053872 399.8193
## child_garden_school_performance_value 0.9554562 119.1774
## school_event_value 6.4862842 809.0572
## school_event_freq 3.3707142 420.4411## $plsrResults
## Partial least squares regression, fitted with the orthogonal scores algorithm.
## Call:
## plsr(formula = y ~ x, ncomp = ncomp, method = "oscorespls", scale = scale)
##
## $r_squared
## NULL
##
## $explained_variance_x
## NULL
##
## $explained_variance_y
## NULL
##
## $important_vars
## Variable
## if_community_likes if_community_likes
## if_garden_yield_enough if_garden_yield_enough
## garden_mental_health_value garden_mental_health_value
## child_garden_health_care_savings child_garden_health_care_savings
## child_garden_school_performance_value child_garden_school_performance_value
## school_event_value school_event_value
## school_event_freq school_event_freq
## VIP Coefficient
## if_community_likes 3.5842837 447.0804
## if_garden_yield_enough 0.9928668 123.8438
## garden_mental_health_value 2.0635014 257.3878
## child_garden_health_care_savings 3.2053872 399.8193
## child_garden_school_performance_value 0.9554562 119.1774
## school_event_value 6.4862842 809.0572
## school_event_freq 3.3707142 420.4411STEM options for private schools:
pls_posthoc(plsrResults = pls_result_STEM, threshold = 0.9)## Data: X dimension: 10000 85
## Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
## 1 comps
## X 1.205
## y 74.335
## Data: X dimension: 10000 85
## Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
## 1 comps
## X 1.205
## y 74.335
## Data: X dimension: 10000 85
## Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
## 1 comps
## X 1.205
## y 74.335
## PLS Model Summary:
## Number of Components: 1
## R-squared Value for Y:
## % Variance Explained in X:
## % Variance Explained in Y:
##
## Important Variables (VIP > 0.9):
## Variable
## if_community_likes if_community_likes
## annual_teacher_training annual_teacher_training
## garden_mental_health_value garden_mental_health_value
## child_STEM_community_engagement_value child_STEM_community_engagement_value
## school_event_value school_event_value
## school_event_freq school_event_freq
## VIP Coefficient
## if_community_likes 3.579643 444.4418
## annual_teacher_training 2.748437 -341.2408
## garden_mental_health_value 1.964477 243.9058
## child_STEM_community_engagement_value 1.500982 186.3592
## school_event_value 6.564693 815.0599
## school_event_freq 3.343556 415.1296## $plsrResults
## Partial least squares regression, fitted with the orthogonal scores algorithm.
## Call:
## plsr(formula = y ~ x, ncomp = ncomp, method = "oscorespls", scale = scale)
##
## $r_squared
## NULL
##
## $explained_variance_x
## NULL
##
## $explained_variance_y
## NULL
##
## $important_vars
## Variable
## if_community_likes if_community_likes
## annual_teacher_training annual_teacher_training
## garden_mental_health_value garden_mental_health_value
## child_STEM_community_engagement_value child_STEM_community_engagement_value
## school_event_value school_event_value
## school_event_freq school_event_freq
## VIP Coefficient
## if_community_likes 3.579643 444.4418
## annual_teacher_training 2.748437 -341.2408
## garden_mental_health_value 1.964477 243.9058
## child_STEM_community_engagement_value 1.500982 186.3592
## school_event_value 6.564693 815.0599
## school_event_freq 3.343556 415.1296PLS for public schools:
# For passive education garden option
source("functions/pls_model.R")
pls_result_garden_public <- pls_model(object = garden_simulation_results,
resultName = names(garden_simulation_results$y)[3],
# "NPV_garden_public_school"
ncomp = 1)
# read in the common input table
input_table <- read.csv("data/inputs_school_garden.csv")
label_public_school <- "Public school"
# source the plot function
source("functions/plot_pls.R")
plot_pls_garden_public <- plot_pls(pls_result_garden_public,
input_table = input_table, threshold = 0.9) +
theme(legend.position = "none", axis.title.x = element_blank(),
axis.text.x = element_blank(),
axis.ticks = element_blank()) +
scale_x_continuous(limits = c(0, 7)) + ggtitle(label_public_school) +
annotate(geom="text", x=5, y=1, label="Passive garden")
#For school garden with formal STEM education
pls_result_STEM_public <- pls_model(object = garden_simulation_results,
resultName = names(garden_simulation_results$y)[4],
# "NPV_garden_STEM_public_school"
ncomp = 1)
plot_pls_public_STEM <- plot_pls(pls_result_STEM_public,
input_table = input_table, threshold = 0.9) + scale_x_continuous(limits = c(0, 7)) +
annotate(geom="text", x=5, y=1, label="STEM garden")
plot_pls_garden_public / plot_pls_public_STEM 
Interpretation of PLS results for public schools
Garden option in public school:
pls_posthoc(plsrResults = pls_result_garden_public, threshold = 0.9)## Data: X dimension: 10000 85
## Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
## 1 comps
## X 1.213
## y 36.854
## Data: X dimension: 10000 85
## Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
## 1 comps
## X 1.213
## y 36.854
## Data: X dimension: 10000 85
## Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
## 1 comps
## X 1.213
## y 36.854
## PLS Model Summary:
## Number of Components: 1
## R-squared Value for Y:
## % Variance Explained in X:
## % Variance Explained in Y:
##
## Important Variables (VIP > 0.9):
## Variable
## if_community_likes if_community_likes
## garden_mental_health_value garden_mental_health_value
## child_garden_health_care_savings child_garden_health_care_savings
## child_garden_school_performance_value child_garden_school_performance_value
## school_event_value school_event_value
## school_event_freq school_event_freq
## suitability_of_land_for_garden suitability_of_land_for_garden
## beurocratic_barriers beurocratic_barriers
## VIP Coefficient
## if_community_likes 3.4945244 302.88024
## garden_mental_health_value 2.1018058 182.16941
## child_garden_health_care_savings 3.0274769 262.39992
## child_garden_school_performance_value 0.9813592 85.05716
## school_event_value 5.9943910 519.55069
## school_event_freq 2.9867643 258.87125
## suitability_of_land_for_garden 1.7553215 152.13864
## beurocratic_barriers 2.5546418 -221.41797## $plsrResults
## Partial least squares regression, fitted with the orthogonal scores algorithm.
## Call:
## plsr(formula = y ~ x, ncomp = ncomp, method = "oscorespls", scale = scale)
##
## $r_squared
## NULL
##
## $explained_variance_x
## NULL
##
## $explained_variance_y
## NULL
##
## $important_vars
## Variable
## if_community_likes if_community_likes
## garden_mental_health_value garden_mental_health_value
## child_garden_health_care_savings child_garden_health_care_savings
## child_garden_school_performance_value child_garden_school_performance_value
## school_event_value school_event_value
## school_event_freq school_event_freq
## suitability_of_land_for_garden suitability_of_land_for_garden
## beurocratic_barriers beurocratic_barriers
## VIP Coefficient
## if_community_likes 3.4945244 302.88024
## garden_mental_health_value 2.1018058 182.16941
## child_garden_health_care_savings 3.0274769 262.39992
## child_garden_school_performance_value 0.9813592 85.05716
## school_event_value 5.9943910 519.55069
## school_event_freq 2.9867643 258.87125
## suitability_of_land_for_garden 1.7553215 152.13864
## beurocratic_barriers 2.5546418 -221.41797STEM option in public school:
pls_posthoc(plsrResults = pls_result_STEM_public, threshold = 0.9)## Data: X dimension: 10000 85
## Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
## 1 comps
## X 1.209
## y 46.197
## Data: X dimension: 10000 85
## Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
## 1 comps
## X 1.209
## y 46.197
## Data: X dimension: 10000 85
## Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
## 1 comps
## X 1.209
## y 46.197
## PLS Model Summary:
## Number of Components: 1
## R-squared Value for Y:
## % Variance Explained in X:
## % Variance Explained in Y:
##
## Important Variables (VIP > 0.9):
## Variable
## if_community_likes if_community_likes
## annual_teacher_training annual_teacher_training
## garden_mental_health_value garden_mental_health_value
## child_STEM_community_engagement_value child_STEM_community_engagement_value
## school_event_value school_event_value
## school_event_freq school_event_freq
## suitability_of_land_for_garden suitability_of_land_for_garden
## beurocratic_barriers beurocratic_barriers
## VIP Coefficient
## if_community_likes 3.5258175 298.40772
## annual_teacher_training 3.4643766 -293.20767
## garden_mental_health_value 1.9841407 167.92784
## child_STEM_community_engagement_value 1.3770869 116.54981
## school_event_value 6.2015333 524.86705
## school_event_freq 3.0652792 259.43004
## suitability_of_land_for_garden 0.9652043 81.69011
## beurocratic_barriers 1.5621160 -132.20976## $plsrResults
## Partial least squares regression, fitted with the orthogonal scores algorithm.
## Call:
## plsr(formula = y ~ x, ncomp = ncomp, method = "oscorespls", scale = scale)
##
## $r_squared
## NULL
##
## $explained_variance_x
## NULL
##
## $explained_variance_y
## NULL
##
## $important_vars
## Variable
## if_community_likes if_community_likes
## annual_teacher_training annual_teacher_training
## garden_mental_health_value garden_mental_health_value
## child_STEM_community_engagement_value child_STEM_community_engagement_value
## school_event_value school_event_value
## school_event_freq school_event_freq
## suitability_of_land_for_garden suitability_of_land_for_garden
## beurocratic_barriers beurocratic_barriers
## VIP Coefficient
## if_community_likes 3.5258175 298.40772
## annual_teacher_training 3.4643766 -293.20767
## garden_mental_health_value 1.9841407 167.92784
## child_STEM_community_engagement_value 1.3770869 116.54981
## school_event_value 6.2015333 524.86705
## school_event_freq 3.0652792 259.43004
## suitability_of_land_for_garden 0.9652043 81.69011
## beurocratic_barriers 1.5621160 -132.20976Value of Information
Here we assess value of information with the multi_EVPI
function. We calculate value of information in the form of Expected
Value of Perfect Information (EVPI).
# Subset the outputs from the mcSimulation function (y) by selecting the correct variables be sure to run the multi_EVPI only on the variables that we want. Find them with names(garden_simulation_results$y)
mcSimulation_table <- data.frame(garden_simulation_results$x,
garden_simulation_results$y[1:4])
# List of NPV variables to move to the last position (calculate 4 EVPIs only)
npvs_to_move <- c("NPV_garden_inclusive", "NPV_garden_STEM_inclusive",
"NPV_garden_public_school_inclusive", "NPV_garden_STEM_public_school_inclusive")
# Move NPV variables to the last position
mcSimulation_table <- mcSimulation_table %>% select(-all_of(npvs_to_move), all_of(npvs_to_move))Calculate EVPI:
# source("functions/multi_EVPI_test.R")
# evpi <- multi_EVPI_test(mc = mcSimulation_table, first_out_var = "NPV_garden_inclusive")
# # save as a local .csv (takes ~ 15 minutes to run this)
# save(evpi,file="data/data_evpi.Rda")
load("data/data_evpi.Rda")
# open from saved file (last model run) - it is stable result / takes very long to run EVPI for private schools:
#Value of information the garden intervention decision
source("functions/plot_evpi.R")
# plot_evpi_garden <- plot_evpi(EVPIresults = evpi,
# decision_vars = "NPV_garden_inclusive",
# new_names = "Garden",
# input_table = input_table,
# threshold = 10) +
# theme(legend.position = "none", axis.title.x = element_blank(),
# axis.text.x = element_blank(),
# axis.ticks = element_blank()) +
# scale_x_continuous(limits = c(0, 210))# Value of information for the garden option with formal STEM education.
# using the results of the same multi_EVPI
# plot_evpi_STEM <- plot_evpi(EVPIresults = evpi,
# decision_vars = "NPV_garden_STEM_inclusive",
# new_names = "STEM garden pivate school",
# input_table = input_table,
# threshold = 10) + scale_x_continuous(limits = c(0, 30)) # + ggtitle(label_private_school)
# plot_evpi_garden / plot_evpi_STEMEVPI for public schools:
# Value of information for the public school garden option with no formal STEM education.
# using the results of the same multi_EVPI
# plot_evpi_public <- plot_evpi(evpi, decision_vars = "NPV_garden_public_school_inclusive",
# new_names = "Garden",
# input_table = input_table,
# threshold = 10) +
# theme(legend.position = "none", axis.title.x = element_blank(),
# axis.text.x = element_blank(),
# axis.ticks = element_blank()) +
# scale_x_continuous(limits = c(0, 30))# Value of information for the public school garden option with formal STEM education.
# using the results of the same multi_EVPI
plot_evpi_public_STEM <- plot_evpi(evpi, decision_vars = "NPV_garden_STEM_public_school_inclusive",
new_names = "STEM garden public school",
input_table = input_table,
threshold = 10) +
scale_x_continuous(limits = c(0, 30)) # + ggtitle(label_public_school)
plot_evpi_public_STEM
Pareto-optimal solutions
Our Pareto-optimal solutions represent the best trade-offs among the objectives of biodiversity, child health, and economic return. By focusing on these Pareto-optimal points, the analysis highlights solutions where improvements in one objective cannot be achieved without some compromise in at least one other.
source("pareto/plot_pareto_scenarios.R")
final_plot
# Save the plot
ggsave("figures/Fig_8_pareto_fronts.png", final_plot, width = 10, height = 8, bg = "white")Controllable variables included:
estimates = read.csv("data/inputs_school_garden.csv")
estimates = estimates[estimates$variable !="", ]
estimates[estimates$control_status == "controllable", ]## variable lower median upper distribution
## 6 size_of_garden 5.0 NA 100.0 posnorm
## 21 if_animals_in_garden 0.2 NA 0.8 tnorm_0_1
## 54 if_school_has_canteen 0.2 NA 0.5 tnorm_0_1
## 94 school_event_freq 3.0 NA 10.0 posnorm
## 98 if_parking 0.1 NA 0.8 tnorm_0_1
## label control_status
## 6 Size of school garden in (m2) controllable
## 21 Chance of school choosing to integrate animals in garden (%) controllable
## 54 Chance that the school has a canteen (%) controllable
## 94 Number of school events per year (days/year) controllable
## 98 Chance of including parking on the plot without a garden (%) controllableVariables that are considered out of the control of the decision maker included:
estimates[estimates$control_status != "controllable", ]## variable lower median upper distribution
## 1 number_of_years 5.000 NA 5.00 const
## 2 discount_rate 3.000 NA 8.00 posnorm
## 3 CV_value 0.100 NA 0.40 tnorm_0_1
## 4 inflation_rate 5.000 NA 10.00 posnorm
## 8 if_students_like 0.500 NA 0.80 tnorm_0_1
## 9 if_parents_like 0.500 NA 0.90 tnorm_0_1
## 10 if_community_likes 0.100 NA 0.85 tnorm_0_1
## 11 if_effective_manage 0.500 NA 0.70 tnorm_0_1
## 12 if_garden_yield_enough 0.300 NA 0.80 tnorm_0_1
## 13 if_garden_healthy 0.500 NA 0.90 tnorm_0_1
## 14 if_teachers_like 0.200 NA 0.90 tnorm_0_1
## 15 if_effective_teaching 0.200 NA 0.90 tnorm_0_1
## 16 if_effective_training 0.200 NA 0.80 tnorm_0_1
## 17 if_offer_green_space 0.500 NA 0.90 tnorm_0_1
## 18 if_reduce_pollution 0.200 NA 0.50 tnorm_0_1
## 19 if_biophysical_good 0.200 NA 0.80 tnorm_0_1
## 22 livestock_establishment_costs 5.000 NA 25.00 posnorm
## 23 fishpond_cost 7.000 NA 10.00 posnorm
## 24 manure_yield_effect 0.010 NA 0.10 posnorm
## 25 livestock_mental_health_effect 0.010 NA 0.10 posnorm
## 27 equipment_cost 6.000 NA 20.00 posnorm
## 28 construction_cost 6.500 NA 130.50 posnorm
## 29 garden_designing_costs 10.000 NA 15.00 posnorm
## 30 teacher_training_cost 5.000 NA 20.00 posnorm
## 31 school_board_planning 6.000 NA 12.00 posnorm
## 32 teaching_equipment 5.000 NA 10.00 posnorm
## 33 compost_starting 5.000 NA 10.00 posnorm
## 34 worm_starting 3.000 NA 10.00 posnorm
## 36 if_family_pays_establishment 0.200 NA 0.50 tnorm_0_1
## 37 establishment_family_portion_paid 0.200 NA 0.80 tnorm_0_1
## 39 maintaining_labor 25.000 NA 40.00 posnorm
## 40 maintaining_labor_m2 0.250 NA 0.40 posnorm
## 41 teacher_salary_cost 20.000 NA 30.00 posnorm
## 42 teaching_equipment_annual 1.000 NA 40.00 posnorm
## 43 teaching_tools 2.000 NA 10.00 posnorm
## 44 seed_costs 5.000 NA 20.00 posnorm
## 45 seed_costs_m2 0.050 NA 0.20 posnorm
## 46 fertilizer 1.000 NA 2.00 posnorm
## 47 fertilizer_m2 0.010 NA 0.02 posnorm
## 48 plant_protection 2.000 NA 5.00 posnorm
## 49 plant_protection_m2 0.020 NA 0.05 posnorm
## 50 livestock_maint 2.000 NA 10.00 posnorm
## 51 livestock_maint_m2 0.020 NA 0.10 posnorm
## 52 annual_teacher_training 5.000 NA 276.00 posnorm
## 55 canteen_savings 1.000 NA 5.00 posnorm
## 56 canteen_savings_m2 0.010 NA 0.05 posnorm
## 57 sale_of_yield 10.000 NA 30.00 posnorm
## 58 sale_of_yield_m2 0.100 NA 0.30 posnorm
## 59 extra_cirricular_savings 20.000 NA 100.00 posnorm
## 60 formal_edu_savings 1.000 NA 3.00 posnorm
## 61 formal_edu_savings_STEM 20.000 NA 100.00 posnorm
## 63 outside_investment_value 1.000 NA 5.00 posnorm
## 64 outside_investment_value_STEM 1.000 NA 8.00 posnorm
## 66 increased_enrollment_value 0.100 NA 5.00 posnorm
## 67 increased_enrollment_value_STEM 10.000 NA 100.00 posnorm
## 69 child_veg_health_care_savings 0.100 NA 5.00 posnorm
## 70 child_veg_school_performance_value 0.010 NA 0.20 posnorm
## 71 child_veg_community_engagement_value 0.010 NA 0.10 posnorm
## 73 garden_mental_health_value 4.000 NA 300.00 posnorm
## 75 child_garden_health_care_savings 9.000 NA 500.00 posnorm
## 76 child_garden_school_performance_value 21.000 NA 182.00 posnorm
## 77 child_garden_community_engagement_value 3.000 NA 7.00 posnorm
## 79 child_STEM_health_care_savings 20.000 NA 80.00 posnorm
## 80 child_STEM_school_performance_value 2.000 NA 100.00 posnorm
## 81 child_STEM_community_engagement_value 10.000 NA 250.00 posnorm
## 83 green_space_eco_value 1.000 NA 10.00 posnorm
## 84 green_space_eco_value_m2 0.010 NA 0.10 posnorm
## 85 reduce_pollution_value 1.000 NA 3.00 posnorm
## 86 reduce_pollution_value_m2 0.010 NA 0.03 posnorm
## 88 chance_garden_is_fallow_green_space 0.001 NA 0.05 tnorm_0_1
## 89 fallow_eco_reduction 0.500 NA 0.80 tnorm_0_1
## 90 green_space_health_value 1.000 NA 10.00 posnorm
## 91 fallow_health_reduction 0.500 NA 0.80 tnorm_0_1
## 93 school_event_value 10.000 NA 200.00 posnorm
## 95 school_event_mgmt_cost 0.500 NA 10.00 posnorm
## 97 value_of_non_garden_land_use 20.000 NA 50.00 posnorm
## 99 parking_value 0.100 NA 3.00 posnorm
## 100 costs_of_non_garden_land_use 1.000 NA 5.00 posnorm
## 102 land_access 0.600 NA 0.95 tnorm_0_1
## 103 suitability_of_land_for_garden 0.600 NA 0.95 tnorm_0_1
## 104 beurocratic_barriers 0.010 NA 0.50 tnorm_0_1
## label
## 1 Number of years for garden simulation
## 2 Discounting factor
## 3 Coefficient of variation for our school garden intervention (%)
## 4 Inflation rate (%)
## 8 Chance of student engagement (%)
## 9 Chance of parents support / effectiveness (%)
## 10 Chance of community support (%)
## 11 Chance of effective garden management (%)
## 12 Chance of sufficient yield from garden (%)
## 13 Chance of healthy food from garden (%)
## 14 Chance of teacher engagement (%)
## 15 Chance of high education quality / effectiveness (%)
## 16 Chance of effective training for teachers (%)
## 17 Chance of garden having ecologically valuable green space (%)
## 18 Chance of garden reducing polution (%)
## 19 Chance of biophysical not damaging (i.e. weather) (%)
## 22 Starting animals in the garden (million VND)
## 23 Digging a fish pond in the garden (million VND)
## 24 Effect of manure on garden yield (%)
## 25 Effect of animals on mental health benefits (%)
## 27 Costs of equipment for setting up garden (million VND)
## 28 Costs of construction for setting up garden (million VND)
## 29 Costs of design team consultant (million VND)
## 30 Costs of training teachers when setting up garden (million VND)
## 31 Costs of planning meetings (million VND)
## 32 Equipment for teaching (million VND)
## 33 Starting compost (million VND)
## 34 Starting worms for compost (million VND)
## 36 Chance that families donate to establishment (%)
## 37 Portion of establishment costs donated by families (%)
## 39 Standard annual Labor cost to maintain school garden (million VND/yr)
## 40 Additional (per m2) annual labor cost to maintain school garden (million VND/yr)
## 41 Standard annual additional teacher salary costs with garden (million VND/yr)
## 42 Standard annual teaching equipment / manitaining microscopes etc. with garden (million VND/yr)
## 43 Standard annual teaching tools / paper etc. with garden (million VND/yr)
## 44 Seeds and seedlings (million VND/yr)
## 45 Additional (per m2) seeds and seedlings (million VND/yr)
## 46 Standard annual fertilizer i.e. EM to add to compost (million VND/yr)
## 47 Additional (per m2) fertilizer i.e. EM to add to compost (million VND/yr)
## 48 Integrated Pest Managemernt (IPM) (million VND/yr)
## 49 Integrated Pest Managemernt (IPM) (million VND/yr)
## 50 Standard annual costs of mainitaining animals (million VND/yr)
## 51 Additional (per m2) mainitaining animals (million VND/yr)
## 52 Mainitaining teacher training (million VND/yr)
## 55 Canteen savings (million VND/yr)
## 56 Canteen savings per m2 (million VND/yr)
## 57 Sales of garden products (million VND/yr)
## 58 Sales of garden products per m2 (million VND/yr)
## 59 Savings from extra-cirriclar activities (million VND/year)
## 60 Savings on formal education costs (no STEM garden) (million VND/year)
## 61 Savings on STEM formal education costs (million VND/year)
## 63 Outside investment value (reputation) garden (million VND/year)
## 64 Outside investment value (reputation) STEM (million VND/year)
## 66 Increased enrollment/tuition income (reputation) garden (million VND/year)
## 67 Increased enrollment/tuition income (reputation) STEM (million VND/year)
## 69 Healthcare savings (child) access to garden (million VND/year)
## 70 School performance (children) eating garden veg (million VND/year)
## 71 Community engagement (children) eating garden veg (million VND/year)
## 73 Mental health value of children/others having a garden at school (million VND/year)
## 75 Healthcare savings (children) with garden (million VND/year)
## 76 School performance value (children) with garden (million VND/year)
## 77 Community engagement value (children) with garden (million VND/year)
## 79 Healthcare savings (children) STEM garden (million VND/year)
## 80 School performance value (children) STEM garden (million VND/year)
## 81 Community engagement value (children) STEM garden (million VND/year)
## 83 Value of green space (million VND/year)
## 84 Value of green space per m2 (million VND/year)
## 85 Value of reduced polution by school garden (million VND/year)
## 86 Value of reduced polution by school garden per m2 (million VND/year)
## 88 Chance that the garden space is fallow green space (%)
## 89 Proportion of value of fallow greenspace compared to garden (%)
## 90 Value of non-garden green space for child health (million VND/year)
## 91 Proportion of value of fallow greenspace for child heatlh compared to garden (%)
## 93 Value of garden related school events (million VND/event)
## 95 Cost of garden related school events (million VND/event)
## 97 Value of non garden land use, playground etc. (million VND/yr)
## 99 Above table value of parking (million VND/yr)
## 100 Cost of non garden land use (million VND/yr)
## 102 Chance that the school has acess to land (%)
## 103 Chance that the land at the school is suitable (%)
## 104 Chance that beurocratic barriers will inhibit the process (%)
## control_status
## 1 uncertain
## 2 uncertain
## 3 uncertain
## 4 uncertain
## 8 uncertain
## 9 uncertain
## 10 uncertain
## 11 uncertain
## 12 uncertain
## 13 uncertain
## 14 uncertain
## 15 uncertain
## 16 uncertain
## 17 uncertain
## 18 uncertain
## 19 uncertain
## 22 uncertain
## 23 uncertain
## 24 uncertain
## 25 uncertain
## 27 uncertain
## 28 uncertain
## 29 uncertain
## 30 uncertain
## 31 uncertain
## 32 uncertain
## 33 uncertain
## 34 uncertain
## 36 uncertain
## 37 uncertain
## 39 uncertain
## 40 uncertain
## 41 uncertain
## 42 uncertain
## 43 uncertain
## 44 uncertain
## 45 uncertain
## 46 uncertain
## 47 uncertain
## 48 uncertain
## 49 uncertain
## 50 uncertain
## 51 uncertain
## 52 uncertain
## 55 uncertain
## 56 uncertain
## 57 uncertain
## 58 uncertain
## 59 uncertain
## 60 uncertain
## 61 uncertain
## 63 uncertain
## 64 uncertain
## 66 uncertain
## 67 uncertain
## 69 uncertain
## 70 uncertain
## 71 uncertain
## 73 uncertain
## 75 uncertain
## 76 uncertain
## 77 uncertain
## 79 uncertain
## 80 uncertain
## 81 uncertain
## 83 uncertain
## 84 uncertain
## 85 uncertain
## 86 uncertain
## 88 uncertain
## 89 uncertain
## 90 uncertain
## 91 uncertain
## 93 uncertain
## 95 uncertain
## 97 uncertain
## 99 uncertain
## 100 uncertain
## 102 uncertain
## 103 uncertain
## 104 uncertainSummarize objective results for the Pareto
An rmoo::summary of the values resulting from the
rmoo::nsga2 minimization of a fitness function using
non-dominated sorting genetic algorithms - II (NSGA-IIs). Multiobjective
evolutionary algorithms with 2500 random draws with the
decisionSupport::random, a population size of 80 and 80
iterations (or ‘generations’ maxiter) in
rmoo::nsga2.
Load the results of a multi-objective optimization run with
load, including the fitness values and population of
solutions. Display the optimal results with rmoo::summary.
The final result@fitness contains the fitness values for
all solutions in the final generation of the optimization. The
rmoo:non_dominated_fronts() identifies which solutions are
Pareto-optimal. The sweep Filters the rescaled fitness
matrix mat to retain only the Pareto-optimal solutions
front1_set indices of Pareto-optimal solutions from
mat2 that includes only these Pareto-optimal solutions. For
example, if mat2 has 80 rows, but front1_set
contains 24 indices, set1 will be a 24×3 matrix.
load(file="data/optimization_results/result_nostem_priv_new.RData")
# loads the previously saved result object from an .RData file. The object
# contains the results of a multi-objective optimization run, including the
# fitness values and population of solutions.
rmoo::summary(result_nostem_priv) # displays a summary of the optimization results##
## Summary of NSGA-II run
## #====================================
## Number of Objectives evaluated: 3
## Total iterations: 80
## Population size: 80
## Nondominated points found: 80 (100% of total)
## Crowding distance bounds: Inf 0
## Mutation Probability: 10%
## Crossover Probability: 80%
##
## Please install package 'ecr' to calculate IGD and GD.
##
## Please install package 'emoa' to calculate hypervolume.
## #====================================mat = result_nostem_priv@fitness
# contains the fitness values for all solutions in the final
# generation of the optimization
front1_set = rmoo::non_dominated_fronts(result_nostem_priv)$fit[[1]]
# rmoo:non_dominated_fronts() to identify which solutions are Pareto-optimal
mat2 = sweep(-mat, 2, c(100, 1, 100) , `*`) # retransform
# Filters the rescaled fitness matrix (mat2) to retain only the Pareto-optimal solutions.
# front1_set= indices of Pareto-optimal solutions from mat2 that includes only
# these Pareto-optimal solutions. Example: If mat2 has 200 rows, but front1_set
# contains 24 indices, set1 will be a 24 × 3 24×3 matrix.
set1 = mat2[front1_set, ]
# Repeat for other options
load(file="data/optimization_results/result_stem_priv_new.RData")
rmoo::summary(result_stem_priv)##
## Summary of NSGA-II run
## #====================================
## Number of Objectives evaluated: 3
## Total iterations: 80
## Population size: 80
## Nondominated points found: 80 (100% of total)
## Crowding distance bounds: Inf 0
## Mutation Probability: 10%
## Crossover Probability: 80%
##
## Please install package 'ecr' to calculate IGD and GD.
##
## Please install package 'emoa' to calculate hypervolume.
## #====================================mat = result_stem_priv@fitness
front1_set = rmoo::non_dominated_fronts(result_stem_priv)$fit[[1]]
mat2 = sweep(-mat, 2, c(100, 1, 100) , `*`) # retransform
set2_1 = mat2[front1_set, ]
set2 = set2_1[set2_1[, 1]>0, ]
load(file="data/optimization_results/result_nostem_pub_new.RData")
rmoo::summary(result_nostem_pub)##
## Summary of NSGA-II run
## #====================================
## Number of Objectives evaluated: 3
## Total iterations: 80
## Population size: 80
## Nondominated points found: 80 (100% of total)
## Crowding distance bounds: Inf 0
## Mutation Probability: 10%
## Crossover Probability: 80%
##
## Please install package 'ecr' to calculate IGD and GD.
##
## Please install package 'emoa' to calculate hypervolume.
## #====================================mat = result_nostem_pub@fitness
front1_set = rmoo::non_dominated_fronts(result_nostem_pub)$fit[[1]]
mat2 = sweep(-mat, 2, c(100, 1, 100) , `*`) # retransform
set3 = mat2[front1_set, ]
load(file="data/optimization_results/result_stem_pub_new.RData")
rmoo::summary(result_stem_pub)##
## Summary of NSGA-II run
## #====================================
## Number of Objectives evaluated: 3
## Total iterations: 80
## Population size: 80
## Nondominated points found: 80 (100% of total)
## Crowding distance bounds: Inf 0
## Mutation Probability: 10%
## Crossover Probability: 80%
##
## Please install package 'ecr' to calculate IGD and GD.
##
## Please install package 'emoa' to calculate hypervolume.
## #====================================mat = result_stem_pub@fitness
front1_set = rmoo::non_dominated_fronts(result_stem_pub)$fit[[1]]
mat2 = sweep(-mat, 2, c(100, 1, 100) , `*`) # retransform
set4 = mat2[front1_set, ]Plot of all options
# Plot Pareto results ####
# Filter outliers
set1 <- set1[set1[, 1] > 0, ]
set2 <- set2[set2[, 1] > 0, ]
set3 <- set3[set3[, 1] > 0, ]
set4 <- set4[set4[, 1] > 0, ]
set1 <- set1[set1[, 2] > 9.6, ]
set2 <- set2[set2[, 2] > 9.6, ]
set3 <- set3[set3[, 2] > 9.6, ]
set4 <- set4[set4[, 2] > 9.6, ]
library(plotly)
library(ggplot2)
library(cowplot)
pareto_3d_plot <- plot_ly() %>%
add_trace(x = set1[,1], y = set1[,2], z = set1[,3],
type = "scatter3d", mode = "markers",
marker = list(color = 'blue', size = 5),
name = 'private, no STEM') %>%
add_trace(x = set2[,1], y = set2[,2], z = set2[,3],
type = "scatter3d", mode = "markers",
marker = list(color = 'red', size = 5),
name = 'private, STEM') %>%
add_trace(x = set3[,1], y = set3[,2], z = set3[,3],
type = "scatter3d", mode = "markers",
marker = list(color = 'green', size = 5),
name = 'public, no STEM') %>%
add_trace(x = set4[,1], y = set4[,2], z = set4[,3],
type = "scatter3d", mode = "markers",
marker = list(color = 'orange', size = 5),
name = 'public, STEM') %>%
layout(scene = list(xaxis = list(title = 'economic'),
yaxis = list(title = 'biodiversity'),
zaxis = list(title = 'health')))
pareto_3d_plotInput data for the simulations
Summary
Here we provide a summary of the garden intervention options. We do
this with a summary table of the simulation results. We show the
percentage of missing values as well as the mean, median and standard
deviation (SD) for each output of our model simulations. We use the
gt_plt_summary() from {gtExtras} and with options from
{svglite}. The table shows the name, the plot overview as well as the
number of missing values, the mean, median and the standard deviation of
the distribution for all variables that were fed into the model from our
input table of uncertainty values.
# Subset the outputs from the mcSimulation function (y) to summarize only on the variables that we want.
# names(garden_simulation_results$x)
mcSimulation_table_x <- data.frame(garden_simulation_results$x[4:7]) #, 21:30, 32:41, 43:70, 73:76) also of possible interest
gtExtras::gt_plt_summary(mcSimulation_table_x) | mcSimulation_table_x | ||||||
| 10000 rows x 4 cols | ||||||
| Column | Plot Overview | Missing | Mean | Median | SD | |
|---|---|---|---|---|---|---|
| inflation_rate | 0.0% | 7.5 | 7.5 | 1.5 | ||
| size_of_garden | 0.0% | 45.7 | 41.8 | 29.6 | ||
| if_students_like | 0.0% | 0.6 | 0.6 | 0.1 | ||
| if_parents_like | 0.0% | 0.7 | 0.7 | 0.1 | ||
# a summary table with missing, mean, median and sdThe table shows the variable name, the plot overview as well as the number of missing values, the mean, median and the standard deviation of the distribution for variables that calculated in the model.
The full repository can be accessed at https://github.com/CWWhitney/urban_school_gardens